; sapid lisp
; sapid implementation of Y combinator
; gilles.arcas@gmail.com, sites.google.com/site/sapidlisp

; see Ycombinator.htm. Here are all fac definitions derived in the html page.

; natural definition

(de fac (n)
    (if (= n 1) 
        1 
        (* n (fac (1- n))) ) ) 
        
(print "(fac 5) -> " (fac 5))

; constructing the lambda definition

(de almost-fac (f)
    `(lambda (n)
        (if (= n 1) 
            1 
            (* n (,f (1- n))) ) ) )

(fvalue 'fac (almost-fac 'fac))

(print "(fac 5) -> " (fac 5))

; passing inner function rather than embedding it

(de part-fac (self n)
    (if (= n 1) 
        1 
        (* n (funcall self self (1- n))) ) )
 
(de fac (n)
    (part-fac 'part-fac n) )
    
(print "(fac 5) -> " (fac 5))

; introducing a (lambda (n) ...) function

(de part-fac (self)
    `(lambda (n)
          (if (= n 1) 
              1 
              (* n (funcall (,self ',self) (1- n))) ) ) ) 

(de fac (n)
    (funcall (part-fac 'part-fac) n) )

(print "(fac 5) -> " (fac 5))

; funcalls are symetrical but it seems better to handle only lambda insode part-fac

(de part-fac (self)
    `(lambda (n)
          (if (= n 1) 
              1 
              (* n (funcall (,self ,self) (1- n))) ) ) ) 

(de fac (n)
    (funcall (part-fac (fvalue 'part-fac)) n) )

(print "(fac 5) -> " (fac 5))

; compute the inner call outside the lambda

(de part-fac (self)
    (let ((f `(,self ,self)))
        `(lambda (n)
            (if (= n 1) 
                1 
                (* n (funcall ,f (1- n))) ) ) ) )

(print "(fac 5) -> " (fac 5))

; transform let into lambda

(de part-fac (self)
    ((lambda (f)
        `(lambda (n)
            (if (= n 0)
                1
                (* n (funcall ,f (1- n))) ) ) )
     `(,self ,self) ) )

(print "(fac 5) -> " (fac 5))

; make almost-fac explicit

(fvalue 'almost-fac
    (lambda (f)
        `(lambda (n)
            (if (= n 0)
                1
                (* n (funcall ,f (1- n))) ) ) ) )

; or:

(de almost-fac (f)
    `(lambda (n) 
        (if (= n 0) 
            1             
            (* n (funcall ,f (1- n))) ) ) )
            
(de part-fac (y)
     (almost-fac `(,y ,y)) )
     
(de fac (n)
    (funcall (part-fac (fvalue 'part-fac)) n) )

(print "(fac 5) -> " (fac 5))

; alternative definition for fac

(fvalue 'fac
    (part-fac (fvalue 'part-fac)) )

(print "(fac 5) -> " (fac 5))

; gather part-fac and fac definitons

(fvalue 'fac
    (let ((part-fac (lambda (y) (almost-fac `(,y ,y)))))
        (funcall part-fac part-fac) ) )

(print "(fac 5) -> " (fac 5))

; renaming and making a lambda

(fvalue 'fac
    ((lambda (x) (funcall x x))
     (lambda (x) (almost-fac `(,x ,x))) ) )

(print "(fac 5) -> " (fac 5))

; construct fac by applying some function to almost-fac

(de make (f)
    ((lambda (x) (funcall x x)) `(lambda (x) (,f `(,x ,x))) ) )

(fvalue 'fac (make 'almost-fac))

(print "(fac 5) -> " (fac 5))

; make function is Y. To summarize:

(de Y (f)
    ((lambda (x) (funcall x x)) `(lambda (x) (,f `(,x ,x))) ) )

(de almost-fac (f)
    `(lambda (n) 
        (if (= n 0) 
            1             
            (* n (funcall ,f (1- n))) ) ) )
            
(fvalue 'fac (Y 'almost-fac))

(print "(fac 5) -> " (fac 5))
